home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
tbbs
/
prgsourc.zip
/
HOMES.ZIP
/
MATCH.PRG
< prev
next >
Wrap
Text File
|
1996-01-08
|
9KB
|
369 lines
PARAMETERS md
PRIVATE cnt
aa[4] = pmax
aa[5] = sub
aa[6] = design
aa[8] = smin
aa[9] = lmin
aa[10] = bedmin
aa[11] = batmin
aa[13] = pump
aa[14] = base
aa[15] = fire
aa[16] = gar
aa[17] = air
p = aa[4] * 1000
STORE 0 TO m,m1,m2,m3
SELECT a
IF md = 3
COUNT TO cnt
ELSE && md = 4
SEEK larea
COUNT TO cnt WHILE area = larea
ENDIF
IF aa[5] = "..No Preference"
IF aa[6] = "..Any "
IF md = 3
COUNT TO m2 FOR price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
GOTO TOP
ELSE
SEEK larea
COUNT TO m2 FOR price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11] WHILE area = larea
SEEK larea
ENDIF
IF m2 = 0
fld="these selections"
DO nmat
RETURN
ELSE
DECLARE amat2[m2] && Check against price,size,
DO strtp
SET ORDER TO 2
ENDIF
ELSE && A design is specified
IF md = 3
COUNT TO m1 FOR design = aa[6]
GOTO TOP
ELSE
SEEK larea
COUNT TO m1 FOR design = aa[6] WHILE area=larea
SEEK larea
ENDIF
IF m1 = 0
fld="this home design"
DO nmat
RETURN
ELSE
DECLARE amat1[m1]
DO strtd
SET ORDER TO 2
ENDIF
DECLARE amat2[m2]
x = 1
m3 = 0
SEEK amat1[x]
DO WHILE x < m2
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
m3 = m3 + 1
amat2[m3] = pic1
ENDIF
x = x + 1
SEEK amat1[x]
ENDDO
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
m3 = m3 + 1
amat2[m3] = pic1
ENDIF
RELEASE amat1
ENDIF
ELSE && A Subdivision is specified
IF md = 3
COUNT TO m FOR sub = aa[5]
GOTO TOP
ELSE && md = 4
SEEK larea
COUNT TO m FOR sub = aa[5] WHILE area=larea
SEEK larea
ENDIF
IF m = 0
fld="this subdivision"
DO nmat
RETURN
ELSE
DECLARE amat[m]
DO strts
ENDIF
SET ORDER TO 2
IF aa[6] = "..Any "
DECLARE amat1[m1]
dummy = aCopy(amat,amat1)
RELEASE amat
m2=m1
DECLARE amat2[m2]
DO endp
ELSE
DECLARE amat1[m1]
DO midd
IF m2 = 0
fld="the design & Sub"
DO nmat
RETURN
ENDIF
DECLARE amat2[m2]
DO endp
ENDIF
ENDIF
IF m3 = 0
fld="these selections"
DO nmat
RELEASE amat2
RETURN
ENDIF
y = 13
DO WHILE y <= 17
IF aa[y]
x = m3
DO WHILE x > 0
SEEK amat2[x]
DO CASE
CASE y = 13
IF .NOT. heatpump
dummy = aDel(amat2,x)
x = x - 1
m3 = m3 - 1
LOOP
ENDIF
CASE y = 14
IF .NOT. basement
dummy = aDel(amat2,x)
x = x - 1
m3 = m3 - 1
LOOP
ENDIF
CASE y = 15
IF fireplace = 0
dummy = aDel(amat2,x)
x = x - 1
m3 = m3 - 1
LOOP
ENDIF
CASE y = 16
IF .NOT. garage
dummy = aDel(amat2,x)
x = x - 1
m3 = m3 - 1
LOOP
ENDIF
CASE y = 17
IF .NOT. ac
dummy = aDel(amat2,x)
x = x - 1
m3 = m3 - 1
LOOP
ENDIF
ENDCASE
x = x - 1
ENDDO
ENDIF
IF m3 = 0
fld="these selections"
DO nmat
RELEASE amat2
RETURN
ENDIF
ENDDO
mat = m3
DO ty
DO BoxB WITH 5,52,8,72
@ 6,53 SAY mat PICTURE "@ 999"
IF mat = 1
@ 6,Col()+1 SAY "match found"
ELSE
@ 6,Col()+1 SAY "matches found"
ENDIF
@ 7,54 SAY "View Now?"
*******************
@ 20,5 SAY "Pausing for 8 seconds...."
key = InKey(8)
*******************
SET COLOR TO N/N
@ 2,0 GET charin
DO WHILE .T.
READ
DO CASE
CASE LastKey() = 89 .OR. LastKey() = 121 && `Y' or `y'
DECLARE amat3[m3]
dummy = aCopy(amat2,amat3,1,m3,1)
RELEASE amat2
EXIT
CASE LastKey() = 78 .OR. LastKey() = 110 && 'N' or 'n'
RELEASE amat2
RETURN
OTHERWISE
LOOP
ENDCASE
ENDDO
x=1
SEEK amat3[1]
DO tt
IF m3 # 1
DO ts
ENDIF
DO vscr
DO view
SET FORMAT TO fscr NOCLEAR
SET COLOR TO N/N
@ 2,0 GET charin
DO WHILE .T.
READ
DO CASE
CASE Lastkey() = 27 && <Esc>
EXIT
CASE LastKey() = 5 && <Up Arrow>
IF x=1
LOOP
ENDIF
x=x-1
SEEK amat3[x]
DO view
LOOP
CASE LastKey() = 24 && <Dn Arrow>
IF x = m3
LOOP
ENDIF
x=x+1
SEEK amat3[x]
DO view
LOOP
CASE LastKey() = 84 .OR. LastKey() = 116 && T or t
DO tag WITH tg
OTHERWISE
LOOP
ENDCASE
ENDDO
RELEASE amat3
RETURN
**************************************************
PROCEDURE strts
x=1
DO WHILE x < cnt
IF sub = aa[5]
m1=m1+1
amat[m1] = pic1
ENDIF
x=x+1
SKIP
ENDDO
IF sub = aa[5]
m1=m1+1
amat[m1] = pic1
ENDIF
RETURN
**************************************************
PROCEDURE strtd
x=1
m2=0
DO WHILE x < cnt
IF design = aa[6]
m2=m2+1
amat1[m2] = pic1
ENDIF
x=x+1
SKIP
ENDDO
IF design = aa[6]
m2=m2+1
amat1[m2] = pic1
ENDIF
RETURN
**************************************************
PROCEDURE strtp
x = 1
m3 = 0
DO WHILE x < cnt
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
m3 = m3 + 1
amat2[m3] = pic1
ENDIF
x = x + 1
SKIP
ENDDO
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
m3=m3+1
amat2[m3] = pic1
ENDIF
RETURN
**************************************************
PROCEDURE midd
x=1
m2=0
SEEK amat[x]
DO WHILE x < m1
IF design = aa[6]
m2=m2+1
amat1[m2] = pic1
ENDIF
x=x+1
SEEK amat[x]
ENDDO
IF design = aa[6]
m2=m2+1
amat1[m2] = pic1
ENDIF
RELEASE amat
RETURN
**************************************************
PROCEDURE nmat
DO BoxB WITH 5,52,8,77
@ 6,54 SAY "No matches were found"
@ 7,54 SAY "for"
@ 7,Col()+1 SAY fld
key = inkey(3)
DO cls WITH 5,52,8,77
IF fld = "this subdivision" .OR. fld = "this home design"
DO BoxB WITH 5,53,8,74
@ 6,55 SAY "Press <Page Dn> to"
@ 7,55 SAY "use the pick list"
key = InKey(3)
DO cls WITH 5,53,8,74
ENDIF
SET COLOR TO W+/N
RETURN
**************************************************
PROCEDURE endp
x=1
m3=0
SEEK amat1[x]
DO WHILE x < m2
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
m3=m3+1
amat2[m3] = pic1
ENDIF
x=x+1
SEEK amat1[x]
ENDDO
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
m3=m3+1
amat2[m3] = pic1
ENDIF
RELEASE amat1
RETURN